home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 3 / DOS065.dsk / DATA BASE.bas < prev    next >
BASIC Source File  |  2012-02-16  |  10KB  |  358 lines
  1. 0 RESTART = 700
  2. 10  REM  LISTS PROGRAM
  3. 20  HTAB 10
  4. 40  GOSUB 21000: REM  COMMAND LIST
  5. 99  REM 
  6. 100  REM  TABLE OF VARIABLES
  7. 101  REM 
  8. 110  REM  N1FLDNBR  
  9. 120  REM  N2HDG(FLDNBR1000
  10. 130  FOR X = 1 TO A1RECNBR
  11. 699  REM 
  12. 700  REM  COMMAND DRIVER
  13. 701  REM 
  14. 710  INPUT "ENTER A COMMAND:<CTRL-G>";REPLY$
  15. 720  IF  LEFT$(REPLY$,1) = "A"  THEN  GOSUB 5000
  16. 725  IF  LEFT$(REPLY$,1) = "B"  THEN  GOSUB 20000
  17. 730  IF  LEFT$(REPLY$,1) = "C"  THEN  GOSUB 6000
  18. 740  IF  LEFT$(REPLY$,1) = "D"  THEN  GOSUB 7000
  19. 743  IF  LEFT$(REPLY$,1) = "E"  THEN  END 
  20. 745  IF  LEFT$(REPLY$,1) = "F"  THEN  GOSUB 26000
  21. 750  IF  LEFT$(REPLY$,1) = "G"  THEN  GOSUB 8000
  22. 760  IF  LEFT$(REPLY$,1) = "H"  THEN  GOSUB 21000
  23. 780  IF  LEFT$(REPLY$,1) = "N"  THEN  GOSUB 27000
  24. 790  IF  LEFT$(REPLY$,1) = "P"  THEN  GOSUB 10000
  25. 800  IF  LEFT$(REPLY$,1) = "R"  THEN  GOSUB 11000
  26. 810  IF  LEFT$(REPLY$,1) = "S"  THEN  GOSUB 12000
  27. 990  GOTO 700
  28. 999  END 
  29. 1000  REM 
  30. 1001  REM  INITIALIZE
  31. 1002  REM 
  32. 1390  PRINT 
  33. 1500  REM 
  34. 1501  REM  DEFINE VARIABLES
  35. 1502  REM 
  36. 1510 N9MAXNBRFLDS = 16
  37. 1520  DIM N3FLDLN(N9MAXNBRFLDS)
  38. 1530  DIM N2SEL$(N9MAXNBRFLDS)
  39. 1540  DIM N7FLDNAME$(N9MAXNBRFLDS)
  40. 1550 A1RECNBR = 500
  41. 1560 A2NXTREC = 1
  42. 1990  RETURN 
  43. 2000  REM 
  44. 2001  REM  DEFINE NEW LIST
  45. 2002  REM 
  46. 2010  HOME 
  47. 2020  HTAB 12
  48. 2030  PRINT "CREATE NEW LIST"
  49. 2040  FOR X = 1 TO 39: PRINT "-";: NEXT X: PRINT ""
  50. 2050  PRINT 
  51. 2060  INPUT "HOW MANY FIELDS WITHIN EACH ENTRY";N1FLDNBR
  52. 2070  IF N1FLDNBR >0  AND N1FLDNBR <17  THEN 2080
  53. 2072  PRINT "ENTER A NUMBER BETWEEN 1 AND 16"
  54. 2074  GOTO 2060
  55. 2080  REM  ENDIF
  56. 2990  RETURN 
  57. 3000  REM  
  58. 3001  REM  OPEN FILE 
  59. 3002  REM 
  60. 3900  PRINT : PRINT "NOT IMPLEMENTED.": PRINT 
  61. 3990  RETURN 
  62. 5000  REM 
  63. 5001  REM  ADD RECORD FROM KEYBOARD
  64. 5002  REM 
  65. 5010 P1HDG$ = "ADD A RECORD"
  66. 5020  GOSUB 30000
  67. 5030  PRINT "YOU HAVE ";A1RECNBR -A2NXTREC +1;" RECORDS REMAINING."
  68. 5040  PRINT 
  69. 5045  PRINT "TO EXIT, PRESS RETURN FOR THE": PRINT "FIRST FIELD.": PRINT 
  70. 5050  FOR X = 1 TO N1FLDNBR
  71. 5060  PRINT "ENTER A VALUE FOR ";N7FLDNAME$(X);
  72. 5070  INPUT ":<CTRL-G>";WRKSPACE$(A2NXTREC,X)
  73. 5072  IF X = 1  THEN  IF  LEN(WRKSPACE$(A2NXTREC,X)) = 0  THEN  RETURN 
  74. 5074  IF  LEFT$(WRKSPACE$(A2NXTREC,X),1) = "/"  THEN WRKSPACE$(A2NXTREC,X) = WRKSPACE$(A2NXTREC -1,X): PRINT WRKSPACE$(A2NXTREC,X)
  75. 5080  NEXT X
  76. 5085 A2NXTREC = A2NXTREC +1
  77. 5090  PRINT 
  78. 5130  GOTO 5050
  79. 6000  REM 
  80. 6001  REM  CORRECT A RECORD
  81. 6002  REM 
  82. 6010 P1HDG$ = "CORRECT A RECORD"
  83. 6020  GOSUB 30000
  84. 6030  INPUT "ENTER THE NUMBER OF THE RECORD:";N
  85. 6040  IF N <1  OR N >A2NXTREC -1  THEN  PRINT "THE NUMBER IS TOO LOW OR TOO HIGH!<CTRL-G>": GOTO 6030
  86. 6045 STARTRCD = N: GOSUB 25000
  87. 6050  PRINT 
  88. 6060  PRINT "ENTER A NEW FIELD OR PRESS RETURN"
  89. 6070  PRINT 
  90. 6075 CV =  PEEK(37)
  91. 6080  FOR X = 1 TO N1FLDNBR
  92. 6085  VTAB CV
  93. 6090  PRINT N7FLDNAME$(X);
  94. 6095  CALL  -868: REM  CLEAR LINE
  95. 6096  PRINT "<CTRL-G>";
  96. 6100  INPUT F$
  97. 6110  IF  LEN(F$) < >0  THEN WRKSPACE$(N,X) = F$
  98. 6120  NEXT X
  99. 6130  PRINT 
  100. 6140  RETURN 
  101. 6990  RETURN 
  102. 7000  REM 
  103. 7001  REM  DISPLAY RECORD
  104. 7002  REM 
  105. 7005 STARTRCD = 0
  106. 7006 FIRSTRCD = STARTRCD
  107. 7010 P1HDG$ = "DISPLAY A RECORD"
  108. 7020  GOSUB 30000
  109. 7030  PRINT "ENTER THE NUMBER OF THE FIRST RECORD"
  110. 7040  PRINT "TO BE DISPLAYED."
  111. 7060  PRINT 
  112. 7070  INPUT "ENTER A NUMBER:";START$
  113. 7071  IF  LEN(START$) < >0  THEN STARTRCD =  VAL(START$)
  114. 7072  REM 
  115. 7090  IF STARTRCD = 0  THEN STARTRCD = 1
  116. 7200  IF STARTRCD >A2NXTREC -1  THEN  PRINT : GOTO 7800
  117. 7210  IF STARTRCD <1  THEN STARTRCD = 1
  118. 7250  GOSUB 25000: REM   DISPLAY 1 RCD
  119. 7260 STARTRCD = STARTRCD +1
  120. 7400  IF  PEEK(37) <20  THEN 7200
  121. 7410  INPUT R$
  122. 7430  IF  LEFT$(R$,1) = "-"  THEN STARTRCD = FIRSTRCD - VAL( RIGHT$(R$, LEN(R$) -1)): GOTO 7600
  123. 7440  IF  LEFT$(R$,1) = "+"  THEN STARTRCD = STARTRCD + VAL( RIGHT$(R$, LEN(R$) -1)) -1: GOTO 7600
  124. 7450  IF  LEFT$(R$,1) = "E"  THEN 7800
  125. 7460  IF  LEN(R$) < >0  THEN STARTRCD =  VAL(R$)
  126. 7600  HOME 
  127. 7605 FIRSTRCD = STARTRCD
  128. 7610  GOTO 7072
  129. 7800  RETURN 
  130. 8000  REM 
  131. 8001  REM  ENTER FROM DISK
  132. 8002  REM 
  133. 8010 P1HDG$ = "GET A LIST FROM STORAGE"
  134. 8020  GOSUB 30000
  135. 8025  PRINT "<CTRL-D>CATALOG"
  136. 8027  PRINT 
  137. 8030  INPUT "ENTER A LIST NAME:";N8FILNAME$
  138. 8035  PRINT "<CTRL-D>NOMON C,I,O"
  139. 8040  PRINT "<CTRL-D>OPEN ";N8FILNAME$
  140. 8050  PRINT "<CTRL-D>READ ";N8FILNAME$
  141. 8060  INPUT A1RECNBR$
  142. 8065 A1RECNBR =  VAL(A1RECNBR$)
  143. 8070  INPUT A2NXTREC$
  144. 8075 A2NXTREC =  VAL(A2NXTREC$)
  145. 8080  INPUT N1FLDNBR$
  146. 8085 N1FLDNBR =  VAL(N1FLDNBR$)
  147. 8090  FOR X = 1 TO N1FLDNBR
  148. 8100  INPUT N7FLDNAME$(X)
  149. 8110  NEXT X
  150. 8120  DIM WRKSPACE$(A1RECNBR,N1FLDNBR)
  151. 8130  FOR X = 1 TO A2NXTREC -1
  152. 8150  INPUT R$
  153. 8160  GOSUB 8500
  154. 8170  NEXT X
  155. 8200  GOTO 8900
  156. 8300  REM 
  157. 8301  REM 
  158. 8500  REM  
  159. 8501  REM  UNPACK R$ INTO WRKSPACE$
  160. 8502  REM 
  161. 8505 Z = 1
  162. 8510  FOR Y = 1 TO  LEN(R$)
  163. 8520  IF Z >N1FLDNBR  THEN  RETURN 
  164. 8530  IF  MID$ (R$,Y,1) = "/"  THEN Z = Z +1: GOTO 8550
  165. 8540 WRKSPACE$(X,Z) = WRKSPACE$(X,Z) + MID$ (R$,Y,1)
  166. 8550  NEXT Y
  167. 8560  RETURN 
  168. 8900  PRINT "<CTRL-D>CLOSE ";N8FILNAME$
  169. 8910  PRINT 
  170. 8920  PRINT A2NXTREC -1;" RECORDS GOTTEN FROM STORAGE"
  171. 8930  PRINT 
  172. 8990  RETURN 
  173. 9000  REM 
  174. 9001  REM  LIST 1 RECORD PER LINE
  175. 9002  REM 
  176. 9010  PRINT "LIST IS NOT IMPLEMENTED YET."
  177. 9700  REM  COMMAND DRIVER 
  178. 9990  RETURN 
  179. 10000  REM 
  180. 10001  REM  PUT TO STORAGE
  181. 10002  REM 
  182. 10010 P1HDG$ = "PUT A LIST TO STORAGE"
  183. 10020  GOSUB 30000
  184. 10022  PRINT "ENTER A NEW LIST NAME OR PRESS RETURN": PRINT "TO REWRITE THE LIST UNDER THE OLD NAME": PRINT 
  185. 10025  INPUT "ENTER A LIST NAME:";A$
  186. 10030  IF  LEN(A$) = 0  THEN  PRINT N8FILNAME$
  187. 10031  IF  LEN(A$) < >0  THEN N8FILNAME$ = A$
  188. 10035  PRINT "<CTRL-D>NOMON C,I,O"
  189. 10040  PRINT "<CTRL-D>OPEN ";N8FILNAME$
  190. 10050  PRINT "<CTRL-D>WRITE ";N8FILNAME$
  191. 10060  PRINT A1RECNBR
  192. 10070  PRINT A2NXTREC
  193. 10080  PRINT N1FLDNBR
  194. 10090  FOR X = 1 TO N1FLDNBR
  195. 10100  PRINT N7FLDNAME$(X)
  196. 10110  NEXT X
  197. 10130  FOR X = 1 TO A2NXTREC -1
  198. 10140  FOR Y = 1 TO N1FLDNBR
  199. 10150  PRINT WRKSPACE$(X,Y);"/";
  200. 10160  NEXT Y
  201. 10165  PRINT " "
  202. 10170  NEXT X
  203. 10900  PRINT "<CTRL-D>CLOSE"
  204. 10910  PRINT 
  205. 10920  PRINT A2NXTREC -1;" RECORDS PUT TO STORAGE."
  206. 10930  PRINT 
  207. 10990  RETURN 
  208. 11000  REM 
  209. 11001  REM  REMOVE A RECORD
  210. 11002  REM 
  211. 11010 P1HDG$ = "REMOVE A RECORD"
  212. 11020  GOSUB 30000
  213. 11030  INPUT "ENTER THE RECORD NUMBER:<CTRL-G>";N
  214. 11040  IF N <1  OR N >A2NXTREC  THEN  PRINT "THIS RECORD IS NOT PRESENT<CTRL-G>": GOTO 11030
  215. 11050 STARTRCD = N
  216. 11060  PRINT 
  217. 11070  GOSUB 25000
  218. 11075  PRINT 
  219. 11080  PRINT "TO CONFIRM REMOVE, PRESS RETURN."
  220. 11090  PRINT "TO CANCEL REMOVE, ENTER 'E'."
  221. 11100  INPUT R$
  222. 11105  IF N = A2NXTREC  THEN A2NXTREC = A2NXTREC -1: GOTO 11900
  223. 11110  IF  LEN(R$) < >0  THEN  IF  LEFT$(R$,1) = "E"  THEN  RETURN 
  224. 11120  FOR X = N TO A2NXTREC
  225. 11130  FOR Y = 1 TO N1FLDNBR
  226. 11140 WRKSPACE$(X,Y) = WRKSPACE$(X +1,Y)
  227. 11150  NEXT Y
  228. 11160  NEXT X
  229. 11165 A2NXTREC = A2NXTREC -1
  230. 11200  PRINT 
  231. 11210  PRINT "DELETE MADE"
  232. 11220  PRINT 
  233. 11900  RETURN 
  234. 11990  RETURN 
  235. 12000  REM 
  236. 12001  REM  SORT THE WORKSPACE
  237. 12002  REM 
  238. 12010  PRINT : PRINT "SORT IS NOT IMPLEMENTED YET.": PRINT 
  239. 12990  RETURN 
  240. 20000  REM  
  241. 20001  REM  INITIALIZE WORKSPACE
  242. 20002  REM 
  243. 20005  GOSUB 1000
  244. 20010 P1HDG$ = "BEGIN A NEW LIST"
  245. 20020  GOSUB 30000
  246. 20050  PRINT 
  247. 20060  PRINT "ENTER THE TITLE OF EACH FIELD WHEN RE-"
  248. 20070  PRINT "QUESTED. WHEN YOU HAVE NAMED ALL THE"
  249. 20080  PRINT "FIELDS, JUST PRESS RETURN."
  250. 20090  PRINT 
  251. 20100  FOR X = 1 TO 16
  252. 20110  PRINT "ENTER A NAME FOR FIELD ";X;: INPUT "<CTRL-G>:";N7FLDNAME$(X)
  253. 20120  IF  LEN(N7FLDNAME$(X)) = 0  THEN 20200
  254. 20130 N1FLDNBR = N1FLDNBR +1
  255. 20190  NEXT X
  256. 20199  REM 
  257. 20200  REM 
  258. 20201  REM 
  259. 20260  DIM WRKSPACE$(A1RECNBR,N1FLDNBR)
  260. 20270 A2NXTREC = 1
  261. 21000  REM 
  262. 21001  REM  PRINT MENU
  263. 21002  REM 
  264. 21010 P1HDG$ = "*** COMMAND MENU ***"
  265. 21020  GOSUB 30000
  266. 21040  PRINT "A - ADD RECORDS FROM KEYBOARD"
  267. 21045  PRINT "B - BEGIN A NEW LIST"
  268. 21050  PRINT "C - CORRECT A RECORD"
  269. 21060  PRINT "D - DISPLAY A RECORD IN DETAIL"
  270. 21063  PRINT "E - END THE LISTING SESSION"
  271. 21065  PRINT "F - FIND RECORD(S) WITH SPECIFIC DATA"
  272. 21070  PRINT "G - GET A LIST FROM STORAGE"
  273. 21075  PRINT "H - PRINT THE COMMAND MENU (HELP)"
  274. 21090  PRINT "N - DISPLAY NAMES OF LISTS IN STORAGE"
  275. 21100  PRINT "P - PUT A LIST INTO STORAGE"
  276. 21110  PRINT "R - REMOVE A RECORD FROM THE LIST"
  277. 21300  PRINT 
  278. 21310  PRINT "ENTER THE LETTER THAT CORRESPONDS TO"
  279. 21320  PRINT "THE FUNCTION YOU WANT TO PERFORM."
  280. 21330  PRINT 
  281. 21800  PRINT 
  282. 21990  RETURN 
  283. 22000  REM 
  284. 22001  REM  END THE SESSION
  285. 22010  PRINT 
  286. 22020  PRINT "THANK YOU"
  287. 22030  PRINT 
  288. 22990  END 
  289. 25000  REM 
  290. 25001  REM  DISPLAY 1 RECORD
  291. 25002  REM 
  292. 25010  PRINT 
  293. 25020  NORMAL 
  294. 25030  IF STARTRCD <1  THEN  RETURN 
  295. 25035  IF STARTRCD >A2NXTRCD -1  THEN  RETURN 
  296. 25040  PRINT STARTRCD;
  297. 25050  HTAB 5
  298. 25060  FOR X = 1 TO N1FLDNBR
  299. 25070  NORMAL 
  300. 25080  HTAB 5
  301. 25090  PRINT N7FLDNAME$(X);":";
  302. 25100  INVERSE 
  303. 25110  PRINT WRKSPACE$(STARTRCD,X)
  304. 25120  NEXT X
  305. 25130  NORMAL 
  306. 25300  RETURN 
  307. 26000  REM 
  308. 26001  REM  FIND A RECORD
  309. 26002  REM 
  310. 26010 P1HDG$ = "FIND A RECORD"
  311. 26020  GOSUB 30000
  312. 26030  PRINT "ENTER THE VALUE(S) TO BE FOUND FOR EACH"
  313. 26040  PRINT "FIELD OR PRESS RETURN FOR A FIELD."
  314. 26050  FOR X = 1 TO N1FLDNBR
  315. 26060  PRINT "ENTER A VALUE FOR ";N7FLDNAME$(X);
  316. 26070  INPUT "<CTRL-G>:";N2SEL$(X)
  317. 26080  NEXT X
  318. 26085 A = 1
  319. 26090  FOR X = A TO A2NXTREC
  320. 26100  FOR Y = 1 TO N1FLDNBR
  321. 26110  IF  LEN(N2SEL$(Y)) < >0  THEN  IF N2SEL$(Y) =  LEFT$(WRKSPACE$(X,Y), LEN(N2SEL$(Y)))  THEN STARTRCD = X: GOTO 26500
  322. 26120  NEXT Y
  323. 26130  NEXT X
  324. 26300  PRINT 
  325. 26310  PRINT "THE END OF THE LIST HAS BEEN REACHED"
  326. 26320  PRINT 
  327. 26330  RETURN 
  328. 26500  GOSUB 25000
  329. 26510  PRINT 
  330. 26520  PRINT "TO CONTINUE SEARCHING, PRESS RETURN"
  331. 26530  PRINT "TO END, ENTER 'E'<CTRL-G>";
  332. 26540  INPUT R$
  333. 26550  IF  LEN(R$) < >0  THEN  RETURN 
  334. 26560 A = STARTRCD +1
  335. 26570  GOTO 26090
  336. 27000  REM 
  337. 27001  REM  DISPLAY A CATALOG LISTING
  338. 27002  REM 
  339. 27010 P1HDG$ = "NAMES OF LISTS"
  340. 27020  GOSUB 30000
  341. 27030  PRINT "EACH LIST IS PRECEDED BY THE LETTER 'T'"
  342. 27040  PRINT "YOU MUST ENTER THE FULL NAME EXACTLY AS IT APPEARS"
  343. 27050  PRINT 
  344. 27060  PRINT "<CTRL-D>CATALOG"
  345. 27065  PRINT 
  346. 27070  RETURN 
  347. 30000  REM 
  348. 30001  REM  PRINT HEADING
  349. 30002  REM 
  350. 30010  HOME 
  351. 30020  HTAB (40 - LEN(P1HDG$))/2
  352. 30030  PRINT P1HDG$
  353. 30040  FOR X = 1 TO 39
  354. 30050  PRINT "-";
  355. 30060  NEXT X
  356. 30070  PRINT ""
  357. 30080  PRINT 
  358. 30090  RETURN